Optional Collisions.f

Requires Structs
Requires FixedPoint
Requires SORA\Transformations

Only Forth Definitions

{
Notes

The normal usage is with fixed point numbers, but integers will work too, so long as shape coordinations and transform positions are all integers.

TO DO:
   pre-transform shapes to get some extra speed
   non-aligned collisions
   faster OVERLAP?
   feedback - which side of each shape was "hit" and by how much

Testing

BOX-BOX - OK
POINT-BOX - OK
POINT-OVAL - OK
BOX-OVAL - OK
OVAL-OVAL - OK

}

: overlap? ( xyxy xyxy -- f )
   2swap 2rot rot swap > -rot > or >r
   rot < -rot swap < or r> or not ;

: in? ( xyxy  xy -- flag )
   2>r -1 dup 2+  2r> 2dup overlap? ;

: area
   2over 2+ ;

Struct
   cell field ->x1
   cell field ->y1
   cell field ->x2   \ bottom-right corner or radius x and y
   cell field ->y2
End-struct /Box

: box-box-aligned  ( transform1 shape1 transform2 shape2 -- flag )
   locals| s2 t2 s1 t1 |
   s1 ->x1 2v@ t1 2transform-aligned
   s1 ->x2 2v@ t1 2transform-aligned
   s2 ->x1 2v@ t2 2transform-aligned
   s2 ->x2 2v@ t2 2transform-aligned overlap? ;

: point-box-aligned   ( x. y. transform1 shape1 -- flag )
   locals| s1 t1 | 2>r
   s1 ->x1 2v@ t1 2transform-aligned
   s1 ->x2 2v@ t1 2transform-aligned 2r> in? ;

: point-oval-aligned   ( x. y. transform1 shape1 -- flag )
   locals| s1 t1 |
   s1 ->x1 2v@  t1 ->pos 2v@  2+  2-    \ point is now transformed into the oval's space
   s1 ->x2 2v@  t1 ->scale 2v@ 2scale   \ scale radii
   within-ellipse? ;

: box-oval-aligned   (  transform1 shape1 transform2 shape2 -- flag )
   locals| s2 t2 s1 t1 |
   s1 ->x1 2v@             t1 2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ top-left of rectangle is in the oval
   s1 ->x2 @ s1 ->y1 @     t1 2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ top-right of rectangle is in the oval
   s1 ->x2 2v@             t1 2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ bottom-right of rectangle is in the oval
   s1 ->x1 @ s1 ->y2 @     t1 2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ bottom-left of rectangle is in the oval
   s2 ->x1 2v@ s2 ->y2 @ + t2 2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ bottom-side of oval is in the box
   s2 ->x1 2v@ s2 ->y2 @ - t2 2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ top-side  of oval is in the box
   s2 ->x1 2v@ s2 ->x2 @ u+ t2 2transform-aligned      t1 s1 point-box-aligned  ?dup ?exit  \ right-side of oval is in the box
   s2 ->x1 2v@ s2 ->x2 @ negate u+ t2 2transform-aligned t1 s1 point-box-aligned  ?dup ?exit  \ left-side of oval is in the box
   s2 ->x1 2v@             t2 2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ center of oval is in the box
   false ;

Create temp-shape1 /Box /allot
Create temp-shape2 /Box /allot

: oval-oval-aligned   (  transform1 shape1 transform2 shape2 -- flag )
   locals| s2 t2 s1 t1 |
   s1 ->x1 2v@   s1 ->x2 2v@ 2-   temp-shape1 ->x1 2v!     \ top-left of oval
   s1 ->x2 2v@   temp-shape1 ->x2 2v!                      \ bottom-right of oval
   s2 ->x1 2v@   s2 ->x2 2v@ 2-   temp-shape2 ->x1 2v!     \ top-left of oval
   s2 ->x2 2v@   temp-shape2 ->x2 2v!                      \ bottom-right of oval
   t1 temp-shape1 t2 temp-shape2 box-box-aligned not if false exit then    \ early out
   0.0  16 0 do    s1 ->x2 2v@ third  ellipse-point   s1 ->x1 2v@ 2+  t1 2transform-aligned    t2 s2 point-oval-aligned
      ?dup if unloop nip exit then  22.50 +  loop  drop false ;

: circle-circle  (  transform1 shape1 transform2 shape2 -- flag )
   locals| s2 t2 s1 t1 |
   s1 ->x1 2v@ t1 2transform-aligned
   s2 ->x1 2v@ t2 2transform-aligned  2proximity  s1 ->x2 @  s2 ->x2 @ +  < ;
